/* GUI CONVERTED from repkisa.p (converter v1.76) Tue Jun 25 15:49:48 2002 */
/* repkisa.p - LOCATION TRANSFER SUBROUTINE FOR REPETITIVE PICKLIST     */
/* Copyright 1986-2002 QAD Inc., Carpinteria, CA, USA.                  */
/* All rights reserved worldwide.  This is an unpublished work.         */
/* $Revision: 1.9.3.7 $                                       */
/*V8:ConvertMode=Maintenance                                            */
/* REVISION: 7.3      LAST MODIFIED: 09/06/92   BY: emb *G071*   */
/* Revision: 7.3      Last edit:     09/27/93   By: jcd *G247*   */
/* Oracle changes (share-locks)      09/12/94   BY: rwl *FR25*   */
/* Revision: 7.3      Last edit:     11/01/94   By: emb *GN96*   */
/* REVISION: 7.3      LAST MODIFIED: 12/21/94   BY: WUG *G09R*   */
/* REVISION: 7.3      LAST MODIFIED: 03/15/95   BY: AME *G0HF*   */
/* REVISION: 7.3      LAST MODIFIED: 02/05/96   BY: jym *G1M6*   */
/* REVISION: 7.3      LAST MODIFIED: 09/11/96   BY: *G2DP* Julie Milligan */
/* REVISION: 7.3      LAST MODIFIED: 10/31/96   BY: *G2HG* Julie Milligan */
/* REVISION: 8.6      LAST MODIFIED: 03/15/97   BY: *K04X* Steve Goeke    */
/* REVISION: 8.6      LAST MODIFIED: 02/13/97   BY: *G2L1* Julie Milligan */
/* REVISION: 8.6      LAST MODIFIED: 08/25/97   BY: *H1DL* Todd Runkle    */
/* REVISION: 8.6E     LAST MODIFIED: 02/23/98   BY: *L007* A. Rahane      */
/* REVISION: 8.6E     LAST MODIFIED: 05/20/98   BY: *K1Q4* Alfred Tan     */
/* REVISION: 8.6E     LAST MODIFIED: 08/25/98   BY: *L07B* Jean Miller    */
/* REVISION: 9.1      LAST MODIFIED: 10/01/99   BY: *N014* Vijaya Pakala  */
/* REVISION: 9.1      LAST MODIFIED: 10/06/99   BY: *J3LT* Prashanth Narayan */
/* REVISION: 9.1      LAST MODIFIED: 08/12/00   BY: *N0KP* myb               */
/* REVISION: 9.1      LAST MODIFIED: 09/28/00   BY: *N0WD* Mudit Mehta       */
/* Old ECO marker removed, but no ECO header exists *F0PN*                    */
/* Revision: 1.9.3.5   BY: Ellen Borden   DATE: 06/08/01  ECO: *P00G*         */
/* Revision: 1.9.3.6   BY: Jeff Wootton   DATE: 05/14/02  ECO: *P03G*         */
/* $Revision: 1.9.3.7 $  BY: Jeff Wootton   DATE: 06/03/02  ECO: *P079* */
/******************************************************************************/
/* All patch markers and commented out code have been removed from the source */
/* code below. For all future modifications to this file, any code which is   */
/* no longer required should be deleted and no in-line patch markers should   */
/* be added.  The ECO marker should only be included in the Revision History. */
/******************************************************************************/
/*****************************************************************************/

{mfdeclre.i}
{cxcustom.i "REPKISA.P"}

/* ********** Begin Translatable Strings Definitions ********* */

&SCOPED-DEFINE repkisa_p_1 "Use Workcenter Loc Status"
/* MaxLen: Comment: */

/* ********** End Translatable Strings Definitions ********* */

define     shared variable nbr like lad_nbr format "x(10)".

define     shared variable eff_date as date.
define     shared variable use-to-loc-status like mfc_logical
   label {&repkisa_p_1} no-undo.

define variable part like tr_part.
define variable ref like glt_ref.
define buffer trhist for tr_hist.
define variable lot like tr_lot.
define variable line as character.

define variable lotserial like sr_lotser no-undo.
define variable lotserial_qty like sr_qty no-undo.

define
   new shared
   variable transtype as character format "x(7)" initial "ISS-TR".
define variable from_nettable like mfc_logical.
define variable to_nettable like mfc_logical.
define variable null_ch as character initial "".
define variable intermediate_acct like trgl_dr_acct.
define variable intermediate_sub like trgl_dr_sub.
define variable intermediate_cc like trgl_dr_cc.
define variable from_expire like ld_expire.
define variable from_date like ld_date.
define variable from_status like ld_status no-undo.
define variable temp_qty like sr_qty.

define variable from_assay like ld_assay no-undo.

define variable from_grade like ld_grade no-undo.
define variable glcost like sct_cst_tot.
define variable iss_trnbr like tr_trnbr no-undo.
define variable rct_trnbr like tr_trnbr no-undo.

{&REPKISA-P-TAG1}

laddet-loop:
for each lad_det exclusive-lock where lad_dataset = "rps_det"

      and lad_nbr = nbr and lad_qty_chg <> 0:
/*GUI*/ if global-beam-me-up then undo, leave.


   for each sr_wkfl exclusive-lock where sr_userid = mfguser
         and sr_lineid = string(lad_line,"x(8)") + "::" + lad_part
         and sr_site = lad_site and sr_loc = lad_loc
         and sr_lotser = lad_lot and sr_ref = lad_ref:
/*GUI*/ if global-beam-me-up then undo, leave.


      global_part = lad_part.

      from_expire = ?.
      from_date = ?.

      from_assay = 0.

      from_grade = "".
      find ld_det no-lock where ld_part = lad_part
         and ld_site = lad_site
         and ld_loc = lad_loc and ld_lot = lad_lot
         and ld_ref = lad_ref no-error.
      if available ld_det then do:
         assign
            from_status = ld_status
            from_expire = ld_expire
            from_date = ld_date

            from_assay = ld_assay

            from_grade = ld_grade.
      end.

      find ld_det exclusive-lock where
         ld_site = trim(substring(nbr,1,8)) and
         ld_loc = lad_line and
         ld_part = lad_part and
         ld_lot = sr_lotser and
         ld_ref = sr_ref
         no-error.
      if not available ld_det then do:
         create ld_det.
         assign
            ld_site = trim(substring(nbr,1,8))
            ld_loc = lad_line
            ld_part = lad_part
            ld_lot = sr_lotser
            ld_ref = sr_ref.
         if recid(ld_det) = -1 then .

         find loc_mstr no-lock where loc_site = ld_site  and
            loc_loc = ld_loc no-error.
         if available loc_mstr then ld_status = loc_status.
         else do:
            find si_mstr no-lock where si_site = ld_site no-error.
            if available si_mstr then ld_status = si_status.
         end.

      end. /* not available ld_det */

      if from_expire <> ? then ld_expire = from_expire.
      if from_date <> ? then ld_date = from_date.
      ld_assay = from_assay.
      ld_grade = from_grade.
      if not use-to-loc-status then ld_status = from_status.

      /* INPUT PARAMETER ORDER:                                        */
      /* TR_LOT, TR_SERIAL, LOTREF_FROM, LOTREF_TO QUANTITY, TR_NBR,   */
      /* TR_SO_JOB, TR_RMKS, PROJECT, TR_EFFDATE, SITE_FROM, LOC_FROM, */
      /* SITE_TO, LOC_TO, TEMPID                                       */
      /* SHIP_NBR, SHIP_DATE, INV_MOV,                                 */
      /* GLCOST                                                        */
      /* ASSAY, GRADE, EXPIRE                                          */
      /*CHANGE assay TO from_assay, CHANGE grade TO from_grade         */

      {&REPKISA-P-TAG2}
      {gprun.i ""icxfer.p""
         "("""",
           sr_lotser,
           sr_ref,
           sr_ref,
           sr_qty,
           substring(nbr,9),
           """",
           """",
           """",
           eff_date,
           sr_site,
           sr_loc,
           trim(substring(nbr,1,8)),
           lad_line,
           no,
           """",
           ?,
           """",
           0,
           output glcost,
           output iss_trnbr,
           output rct_trnbr,
           input-output from_assay,
           input-output from_grade,
           input-output from_expire)"
         }
/*GUI*/ if global-beam-me-up then undo, leave.

      {&REPKISA-P-TAG3}

   end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* for each sr_wkfl */

end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* for each lad_det */

/* THIS SECTION WILL REDUCE QUANTITY ALLOCATED AND PICKED */
sr-loop:
for each sr_wkfl exclusive-lock
      where sr_userid = mfguser
      and sr_qty > 0:
   line = sr_rev.
   part = sr_user2.

   /* FIRST TRY TO APPLY USING EXACT LOTSER/REF MATCH */

   lad-loop1:
   for each lad_det exclusive-lock
         where lad_dataset = "rps_det"
         and lad_nbr = nbr
         and lad_line = line
         and lad_part = part
         and (lad_qty_all >= 0 or lad_qty_pick >= 0)
         and lad_site = sr_site
         and lad_loc = sr_loc
         and lad_lot = sr_lotser
         and lad_ref = sr_ref:

      /* SUBTRACT QTY ALLOCATED FROM INVENTORY MASTER */
      find in_mstr
         where in_part = lad_part
         and in_site = lad_site
      exclusive-lock no-error.

      if available in_mstr then
      in_qty_all = in_qty_all -
      min(lad_qty_pick + lad_qty_all,sr_qty).

      find ld_det
         where ld_part = lad_part
         and ld_site = lad_site
         and ld_loc = lad_loc
         and ld_lot = lad_lot
         and ld_ref = lad_ref
      exclusive-lock no-error.

      if available ld_det then
   do:
         ld_qty_all = ld_qty_all -
         min(lad_qty_pick + lad_qty_all,sr_qty).

         /* DELETE NON-PERMANENT ZERO QUANTITY LOCATION DETAIL RECORD*/

         run delete_ld_det
            (buffer ld_det).

      end. /* IF AVAILABLE ld_det */

      temp_qty = lad_qty_pick.
      if lad_qty_pick <> 0 then
      assign
         lad_qty_pick = lad_qty_pick - min(lad_qty_pick,sr_qty)
         /* REDUCE SR_QTY BY THE SAME AMOUNT THAT QTY PICKED  */
         /* WAS REDUCED                                       */
         sr_qty = sr_qty - (temp_qty - lad_qty_pick).
      temp_qty = lad_qty_all.
      if lad_qty_all <> 0 then
      assign
         lad_qty_all = lad_qty_all - min(lad_qty_all,sr_qty).
      /* REDUCE SR_QTY BY THE SAME AMOUNT REDUCED FOR       */
      /* QTY ALLOCATED                                      */
      sr_qty = sr_qty - (temp_qty - lad_qty_all).
      if lad_qty_all = 0 and lad_qty_pick = 0 then delete lad_det.
      if sr_qty = 0 then leave lad-loop1.

   end.  /*lad-loop1*/

   /* NOW TRY TO APPLY NOT USING EXACT LOTSER/REF MATCH */
   if sr_qty <> 0 then do:
      lad-loop2:
      for each lad_det exclusive-lock
            where lad_dataset = "rps_det"
            and lad_nbr = nbr
            and lad_line = line
            and lad_part = part
            and (lad_qty_all >= 0 or lad_qty_pick >= 0):

         /* SUBTRACT QTY ALLOCATED FROM INVENTORY MASTER */
         find in_mstr
            where in_part = lad_part
            and in_site = lad_site
         exclusive-lock no-error.

         if available in_mstr then
         in_qty_all = in_qty_all -

         min(lad_qty_pick + lad_qty_all,sr_qty).

         find ld_det
            where ld_part = lad_part
            and ld_site = lad_site
            and ld_loc = lad_loc
            and ld_lot = lad_lot
            and ld_ref = lad_ref
         exclusive-lock no-error.

         if available ld_det then
      do:
            ld_qty_all = ld_qty_all -

            min(lad_qty_pick + lad_qty_all,sr_qty).

            /* DELETE NON-PERMANENT ZERO QUANTITY LOCATION DETAIL */
            /* RECORD                                             */

            run delete_ld_det
               (buffer ld_det).

         end. /* IF AVAILABLE ld_det */

         temp_qty = lad_qty_pick.
         if lad_qty_pick <> 0 then
         assign
            lad_qty_pick = lad_qty_pick - min(lad_qty_pick,sr_qty)
            /* REDUCE SR_QTY BY THE SAME AMOUNT THAT QTY PICKED  */
            /* WAS REDUCED                                       */
            sr_qty = sr_qty - (temp_qty - lad_qty_pick).
         temp_qty = lad_qty_all.
         if lad_qty_all <> 0 then
         assign
            lad_qty_all = lad_qty_all - min(lad_qty_all,sr_qty).
         /* REDUCE SR_QTY BY THE SAME AMOUNT REDUCED FOR       */
         /* QTY ALLOCATED                                      */
         sr_qty = sr_qty - (temp_qty - lad_qty_all).
         if lad_qty_all = 0 and lad_qty_pick = 0 then delete lad_det.
         if sr_qty = 0 then leave lad-loop2.

      end.  /*lad-loop2*/
   end. /* if sr_qty <> 0 */

   delete sr_wkfl.
end. /* sr-loop */

/* CLEAN UP ANY LAD_DET RECORDS WHERE LAD_QTY_ALL AND */
/* LAD_QTY_PICK = 0.                                  */
for each lad_det exclusive-lock
      where lad_dataset = "rps_det"
      and lad_nbr = nbr
      and lad_qty_all = 0
      and lad_qty_pick = 0:
   delete lad_det.
end.

/* PROCEDURE TO DELETE NON-PERMANENT ZERO QUANTITY */
/* LOCATION DETAILS RECORD                         */

PROCEDURE delete_ld_det:
   define parameter buffer lddet for ld_det.

   for first   loc_mstr
      fields (loc_loc loc_perm loc_site loc_status)
      where   loc_site = ld_site and
      loc_loc  = ld_loc
   no-lock:
   end. /* FOR FIRST loc_mstr */

   if available loc_mstr and not loc_perm then
   do:
      if ld_qty_oh  = 0 and
         ld_qty_all = 0 and
         ld_qty_frz = 0 and
         not can-find(first tag_mstr where tag_site   = ld_site   and
         tag_loc    = ld_loc    and
         tag_part   = ld_part   and
         tag_serial = ld_lot    and
         tag_ref    = ld_ref)   then
   do:
         delete ld_det.
      end. /* IF ld_qty_oh = 0 AND ... */
   end. /* IF AVAILABLE loc_mstr */

END PROCEDURE. /* PROCEDURE delete_ld_det */
